home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1997 #3 / Amiga Plus CD - 1997 - No. 03.iso / pd / programmierung / alienbreed3d2_src / amos / palettecreator.amos / palettecreator.amosSourceCode
AMOS Source Code  |  1997-01-31  |  5KB  |  258 lines
  1. Reserve As Work 15,40000
  2. Dim R(255),G(255),B(255)
  3. Screen Open 0,640,256,4,Hires
  4. Curs Off : Flash Off : Cls 0
  5. Wait Vbl 
  6. Limit Mouse 
  7. Global N
  8. Dim TY(256)
  9. For A=0 To 256 : TY(A)=0 : Next 
  10. Set Rainbow 0,1,257,"(1,0,1)","(1,0,1)","(1,0,1)"
  11. Rainbow 0,0,41,258
  12. Ink 1
  13. Bar 340,0 To 640,256
  14. Ink 3
  15. Bar 0,200 To 56*2,256
  16. Pen 2
  17. Ink 2
  18. Colour 2,$FFF
  19. Colour 3,$F00
  20. Change Mouse 2
  21. CO=$FFF
  22. Set Slider 2,2,0,,0,2,2,
  23. Hslider 0,20 To 256,30,256,256,1
  24. Hslider 0,40 To 256,50,256,256,1
  25. Hslider 0,60 To 256,70,256,256,1
  26. Colour 3,CO
  27. Reserve Zone 14
  28. Set Zone 1,0,20 To 256,30
  29. Set Zone 2,0,40 To 256,50
  30. Set Zone 3,0,60 To 256,70
  31. Gosub DRSCR
  32. R=15 : G=15 : B=15 : MO=0 : ST=0 : EN=255
  33. Ink 2
  34. Draw 320,ST To 328,ST
  35. Draw 320,EN To 328,EN
  36. R=255 : G=255 : B=255
  37. 10
  38. Repeat 
  39.    X=X Screen(0,X Mouse) : Y=Y Screen(0,Y Mouse)
  40.    Locate 0,10 : Print Y;"   "
  41.    M=Mouse Key
  42.    A$=Inkey$
  43.    If A$="s" Then Gosub SAVFIL
  44.    If A$="S" Then Gosub SAVSOURCE
  45.    If A$="l" Then Gosub LOAFIL
  46.    If A$="L" Then Gosub LOABRILFIL
  47. Until M<>0
  48. If X<320 Then Goto 20
  49. If MO=0 and X>340 and M=1
  50.    CO=(R/16)*$100+(G/16)*$10+(B/16)
  51.    Rain(0,Y+1)=CO
  52.    R(Y)=R : G(Y)=G : B(Y)=B
  53. End If 
  54. If M=2 and X>340
  55.    R=R(Y) : G=G(Y) : B=B(Y)
  56.    CO=(R/16)*$100+(G/16)*$10+(B/16)
  57.    Gosub SLID
  58.    
  59.    Locate 32,3 : Print R;"  "
  60.    Locate 32,5 : Print G;"  "
  61.    Locate 32,7 : Print B;"  "
  62.    
  63. End If 
  64. If X<340 and M=1 Then Ink 0 : Draw 320,ST To 328,ST : ST=Y
  65. If X<340 and M=2 Then Ink 0 : Draw 320,EN To 328,EN : EN=Y
  66. Ink 2 : Draw 320,ST To 328,ST
  67. Draw 320,EN To 328,EN
  68. If EN<ST Then P=EN : EN=ST : ST=P
  69. Rainbow 0,0,41,258
  70. Goto 10
  71. 20
  72. If X<280 Then Goto 90
  73. If M=1 Then Ink 2 : TY(Y)=1 Else Ink 0 : TY(Y)=0
  74. Draw 280,Y To 156*2,Y
  75. Goto 10
  76. 90
  77. Z=Zone(X,Y)
  78. Pen 2 : Paper 0
  79. If Z=1 Then Gosub FINDPOS : Hslider 0,20 To 256,30,256,H,1 : R=H : Locate 32,3 : Print R;"  "
  80. If Z=2 Then Gosub FINDPOS : Hslider 0,40 To 256,50,256,H,1 : G=H : Locate 32,5 : Print G;"  "
  81. If Z=3 Then Gosub FINDPOS : Hslider 0,60 To 256,70,256,H,1 : B=H : Locate 32,7 : Print B;"  "
  82. If Z>3 and Z<9 and Z<>7 Then MO=Z-4
  83. If Z=7 Then Gosub SPREAD
  84. CO=(R/16)*256+(G/16)*16+(B/16)
  85. Colour 3,CO
  86. Goto 10
  87. '
  88. SLID:
  89. Hslider 0,20 To 256,30,256,R,1
  90. Hslider 0,40 To 256,50,256,G,1
  91. Hslider 0,60 To 256,70,256,B,1
  92. Colour 3,CO
  93. Return 
  94. '
  95. SPREAD:
  96. CO1=Rain(0,ST)
  97. CO2=Rain(0,EN)
  98. R1=R(ST) : G1=G(ST) : B1=B(ST)
  99. R2=R(EN)-R1 : G2=G(EN)-G1 : B2=B(EN)-B1
  100. D=EN-ST
  101. For A=0 To D
  102.    RA=R1+(R2*A)/D
  103.    GA=G1+(G2*A)/D
  104.    BA=B1+(B2*A)/D
  105.    R(A+ST)=RA
  106.    G(A+ST)=GA
  107.    B(A+ST)=BA
  108.    Rain(0,A+ST+1)=(RA/16)*256+(GA/16)*16+(BA/16)
  109. Next 
  110. Rainbow 0,0,41,258
  111. Return 
  112. '
  113. FINDPOS:
  114. H=X
  115. If H>255 Then H=255
  116. Return 
  117. '
  118. Procedure DK[VA]
  119. Doke N,VA : Add N,2
  120. End Proc
  121.  
  122. DRSCR:
  123. Ink 2
  124. Paper 2
  125. Pen 0
  126. Restore BILLY
  127. For A=0 To 4
  128.    X=A*16
  129.    Bar X,0 To X+14,15
  130.    Locate A*2,0
  131.    Read A$ : Print A$
  132.    Read A$ : Locate A*2,1 : Print A$
  133.    Set Zone A+4,X,0 To X+15,15
  134. Next 
  135. Return 
  136. '
  137. SAVFIL:
  138. Screen Open 2,320,256,4,Lowres
  139. Curs Off : Flash Off : Cls 0
  140. Colour 3,$FFF
  141. Pen 3
  142. Input "filename ";N$
  143. N=Start(15)
  144. For A=0 To 255 : Doke N,R(A) : Doke N+2,G(A) : Doke N+4,B(A) : Add N,6 : Next 
  145. Bsave N$,Start(15) To N
  146. Screen 0
  147. Screen To Front 0
  148. Return 
  149. '
  150.  
  151.  
  152. SAVSOURCE:
  153. Screen Open 2,640,256,4,Hires
  154. Paper 0
  155. Curs Off : Flash Off : Cls 0
  156. Colour 3,$FFF
  157. Pen 3
  158. Print "Saving source file"
  159. Input "filename ";N$
  160. N=Start(15)
  161.  
  162. For X=31 To 24 Step -1
  163. C=0
  164.  
  165. For BM=0 To 7
  166.    V=$C40+BM*$2000
  167.    'M$=" dc.w $106,"+Hex$(V)
  168.    DK[$106] : DK[V]
  169.    'Gosub POKIT 
  170.    For A=0 To 31
  171.       R=R(C) : G=G(C) : B=B(C)
  172.       R=R-255
  173.       R=(R*X)/31
  174.       G=(G*X)/31
  175.       B=(B*X)/31
  176.       R=255+R
  177.       CO=(R/16)*$100+(G/16)*$10+(B/16)
  178.       V=$180+A*2
  179.       DK[V] : DK[CO]
  180.       'M$=" dc.w "+Hex$(V)+","+Hex$(CO)
  181.       '      Print M$ :  
  182.       'Gosub POKIT 
  183.       Add C,1
  184.    Next 
  185. Next 
  186.  
  187. C=0
  188. For BM=0 To 7
  189.    V=$E40+BM*$2000
  190.    'M$=" dc.w $106,"+Hex$(V)
  191.    'Gosub POKIT 
  192.    DK[$106] : DK[V]
  193.    For A=0 To 31
  194.       R=R(C) : G=G(C) : B=B(C)
  195.       R=R-255
  196.       R=(R*X)/31
  197.       G=(G*X)/31
  198.       B=(B*X)/31
  199.       R=255+R
  200.       CO=(R and $F)*$100+(G and $F)*$10+(B and $F)
  201.       V=$180+A*2
  202.       DK[V] : DK[CO]
  203.       'M$=" dc.w "+Hex$(V)+","+Hex$(CO)
  204.       '      Print M$
  205.       'Gosub POKIT 
  206.       Add C,1
  207.    Next 
  208. Next 
  209.  
  210.  DK[$FFFF] : DK[$FFFE]
  211.  
  212. 'M$=" dc.w $ffff,$fffe"
  213. 'Gosub POKIT 
  214.  
  215. Next 
  216.  
  217. Bsave N$,Start(15) To N
  218. Screen 0
  219. Screen To Front 0
  220. Return 
  221. '
  222. POKIT:
  223. For T=1 To Len(M$) : Poke N,Asc(Mid$(M$,T,1)) : Add N,1 : Next 
  224. Poke N,10 : Add N,1
  225. Return 
  226. '
  227. LOAFIL:
  228. Screen Open 2,320,256,4,Lowres
  229. Curs Off : Flash Off : Cls 0
  230. Colour 3,$FFF
  231. Pen 3
  232. Input "filename ";N$
  233. Bload N$,Start(15)
  234. N=Start(15)
  235. For A=0 To 255 : R(A)=Deek(N) : G(A)=Deek(N+2) : B(A)=Deek(N+4) : Add N,6
  236.    Rain(0,A+1)=(R(A)/16)*$100+(G(A)/16)*$10+(B(A)/16)
  237. Next 
  238. Screen 0
  239. Screen To Front 0
  240. Return 
  241.  
  242. LOABRILFIL:
  243. Screen Open 2,320,256,4,Lowres
  244. Curs Off : Flash Off : Cls 0
  245. Colour 3,$FFF
  246. Pen 3
  247. Input "filename ";N$
  248. Bload N$,Start(15)
  249. N=Hunt(Start(15) To Start(15)+10000,"CMAP")+8
  250. For A=0 To 255 : R(A)=Peek(N) : G(A)=Peek(N+1) : B(A)=Peek(N+2) : Add N,3
  251.    Rain(0,A+1)=(R(A)/16)*$100+(G(A)/16)*$10+(B(A)/16)
  252. Next 
  253. Screen 0
  254. Screen To Front 0
  255. Return 
  256.  
  257. BILLY:
  258. Data "P"," ","S","t","E","n","S","p","C","o"